home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / ice-9 / time.scm < prev   
Encoding:
Text File  |  2004-01-06  |  3.1 KB  |  82 lines
  1. ;;;;     Copyright (C) 2001 Free Software Foundation, Inc.
  2. ;;;;
  3. ;;;; This program is free software; you can redistribute it and/or modify
  4. ;;;; it under the terms of the GNU General Public License as published by
  5. ;;;; the Free Software Foundation; either version 2, or (at your option)
  6. ;;;; any later version.
  7. ;;;;
  8. ;;;; This program is distributed in the hope that it will be useful,
  9. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. ;;;; GNU General Public License for more details.
  12. ;;;;
  13. ;;;; You should have received a copy of the GNU General Public License
  14. ;;;; along with this software; see the file COPYING.  If not, write to
  15. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16. ;;;; Boston, MA 02111-1307 USA
  17. ;;;;
  18. ;;;; As a special exception, the Free Software Foundation gives permission
  19. ;;;; for additional uses of the text contained in its release of GUILE.
  20. ;;;;
  21. ;;;; The exception is that, if you link the GUILE library with other files
  22. ;;;; to produce an executable, this does not by itself cause the
  23. ;;;; resulting executable to be covered by the GNU General Public License.
  24. ;;;; Your use of that executable is in no way restricted on account of
  25. ;;;; linking the GUILE library code into it.
  26. ;;;;
  27. ;;;; This exception does not however invalidate any other reasons why
  28. ;;;; the executable file might be covered by the GNU General Public License.
  29. ;;;;
  30. ;;;; This exception applies only to the code released by the
  31. ;;;; Free Software Foundation under the name GUILE.  If you copy
  32. ;;;; code from other Free Software Foundation releases into a copy of
  33. ;;;; GUILE, as the General Public License permits, the exception does
  34. ;;;; not apply to the code that you add in this way.  To avoid misleading
  35. ;;;; anyone as to the status of such modified files, you must delete
  36. ;;;; this exception notice from them.
  37. ;;;;
  38. ;;;; If you write modifications of your own for GUILE, it is your choice
  39. ;;;; whether to permit this exception to apply to your modifications.
  40. ;;;; If you do not wish that, delete this exception notice.
  41. ;;;;
  42.  
  43. ;;; Commentary:
  44.  
  45. ;; This module exports a single macro: `time'.
  46. ;; Usage: (time exp)
  47. ;;
  48. ;; Example:
  49. ;; guile> (time (sleep 3))
  50. ;; clock utime stime cutime cstime gctime
  51. ;; 3.01  0.00  0.00   0.00   0.00   0.00
  52. ;; 0
  53.  
  54. ;;; Code:
  55.  
  56. (define-module (ice-9 time)
  57.   :use-module (ice-9 format)
  58.   :export (time))
  59.  
  60. (define (time-proc proc)
  61.   (let* ((gc-start (gc-run-time))
  62.          (tms-start (times))
  63.          (result (proc))
  64.          (tms-end (times))
  65.          (gc-end (gc-run-time)))
  66.     (define (get proc start end)
  67.       (/ (- (proc end) (proc start)) internal-time-units-per-second))
  68.     (display "clock utime stime cutime cstime gctime\n")
  69.     (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
  70.             (get tms:clock tms-start tms-end)
  71.             (get tms:utime tms-start tms-end)
  72.             (get tms:stime tms-start tms-end)
  73.             (get tms:cutime tms-start tms-end)
  74.             (get tms:cstime tms-start tms-end)
  75.             (get identity gc-start gc-end))
  76.     result))
  77.  
  78. (define-macro (time exp)
  79.   `(,time-proc (lambda () ,exp)))
  80.  
  81. ;;; time.scm ends here
  82.